home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / nrpas13.arc / CNTAB2.PAS < prev    next >
Pascal/Delphi Source File  |  1991-05-01  |  1KB  |  60 lines
  1. PROCEDURE cntab2(nn: narray; ni,nj: integer;
  2.       VAR h,hx,hy,hygx,hxgy,uygx,uxgy,uxy: real);
  3. (* Programs using routine CNTAB2 must define type
  4. TYPE
  5.    narray = ARRAY [1..ni,1..nj] OF integer;
  6. in the calling routine. *)
  7. CONST
  8.    maxi=100;
  9.    maxj=100;
  10.    tiny=1.0e-30;
  11. VAR
  12.    j,i: integer;
  13.    sum,p: real;
  14.    sumi: ARRAY[1..maxi] OF real;
  15.    sumj: ARRAY[1..maxj] OF real;
  16. BEGIN
  17.    sum := 0;
  18.    FOR i := 1 TO ni DO BEGIN
  19.       sumi[i] := 0.0;
  20.       FOR j := 1 TO nj DO BEGIN
  21.          sumi[i] := sumi[i]+nn[i,j];
  22.          sum := sum+nn[i,j]
  23.       END
  24.    END;
  25.    FOR j := 1 TO nj DO BEGIN
  26.       sumj[j] := 0.0;
  27.       FOR i := 1 TO ni DO BEGIN
  28.          sumj[j] := sumj[j]+nn[i,j]
  29.       END
  30.    END;
  31.    hx := 0.0;
  32.    FOR i := 1 TO ni DO BEGIN
  33.       IF (sumi[i] <> 0.0) THEN BEGIN
  34.          p := sumi[i]/sum;
  35.          hx := hx-p*ln(p)
  36.       END
  37.    END;
  38.    hy := 0.0;
  39.    FOR j := 1 TO nj DO BEGIN
  40.       IF (sumj[j] <> 0.0) THEN BEGIN
  41.          p := sumj[j]/sum;
  42.          hy := hy-p*ln(p)
  43.       END
  44.    END;
  45.    h := 0.0;
  46.    FOR i := 1 TO ni DO BEGIN
  47.       FOR j := 1 TO nj DO BEGIN
  48.          IF (nn[i,j] <> 0) THEN BEGIN
  49.             p := nn[i,j]/sum;
  50.             h := h-p*ln(p)
  51.          END
  52.       END
  53.    END;
  54.    hygx := h-hx;
  55.    hxgy := h-hy;
  56.    uygx := (hy-hygx)/(hy+tiny);
  57.    uxgy := (hx-hxgy)/(hx+tiny);
  58.    uxy := 2.0*(hx+hy-h)/(hx+hy+tiny)
  59. END;
  60.